;;; fr-trans.el --- 翻译功能

;;; Commentary:
;; 在 Emacs 内添加翻译功能
;; 当前包能不定义快捷键, 快捷键由自己决定
;; 这个包里主要使用的函数是 fr-get-translation 及其衍生函数

;;; Code:
(require 's)
(require 'posframe)

(defcustom fr-tooltip-name "*fr-trans-tooltip*"
  "在 fr-trans 中使用的 提示框posframe 的名称."
  :type 'string
  :group 'fr-trans)

(defvar fr-tooltip-last-point 0
  "显示提示框时鼠标的位置值.")

(defvar fr-tooltip-last-scroll-offset 0
  "显示提示框时滚动的位置值.")

(defvar fr-trans-temp-buffer "*trans-result*"
  "翻译程序返回结果所使用的 buffer 名称.")

(defvar fr-trans-app-path (expand-file-name "~/.emacs.d/bin/trans")
  "定义 translate-shell 程序的路径.")

;; msys2 下的输入编码需要改为 gbk..有点迷
(defvar fr-trans-process-coding (if (eq system-type 'windows-nt)
                                    (cons 'utf-8 'gbk)
                                  nil)
  "定义执行 translate-shell 时的编码形式, 如果 MSYS2 环境下, 输入需要改为 gbk.")

;; 关闭鼠标位置移动
(setq posframe-mouse-banish nil)

(defun fr-hide-tooltip-after-move ()
  "在光标移动后自动关闭提示."
  (ignore-errors
    (when (get-buffer fr-tooltip-name)
      (unless (and
               (equal (point) fr-tooltip-last-point)
               (equal (window-start) fr-tooltip-last-scroll-offset))
        (posframe-delete fr-tooltip-name)
        ))))

(defun fr-trim-process-result (result)
  "去掉 RESULT 中最后的附加说明字符.
这里保留了空行, 便于 posframe 显示完整字符."
  (s-replace-regexp "Process.*$" "" (s-trim-right result)))

(defun fr-after-trans-buffer-changed (begin end length)
  "翻译程序异步执行完成之后的回调.
BEGIN 起始.
END 结束.
LENGTH 变化长度."
  (if (> (buffer-size) 0)
      (let* ((result (fr-trim-process-result (buffer-string)))
             (lines (s-lines result))
             ;; 第3或4行是简单翻译(如果没有注音就是第三行)
             ;; 如果有注音, 第三行就是空行, 第四行才是翻译
             (translation (if (> (length (s-trim (nth 2 lines))) 0)
                              (s-trim (nth 2 lines))
                            (s-trim (nth 3 lines)))))
        (progn
          (message nil) ;; 清除等待提示
          (if translation
              (kill-new translation)) ;; 如果有翻译, 就将结果插入 kill-ring 中, 便于黏贴
          (posframe-show
           fr-tooltip-name
           :string result
           :position fr-tooltip-last-point
           :timeout 30 ;; 过多少秒之后自动消失
           :background-color "gray25"
           :foreground-color "green"
           :internal-border-width 2 ;; 实际上边框的意义不是很大, 因为默认可能不显示边框...
           :internal-border-color "gray50"
           )
          (add-hook 'post-command-hook 'fr-hide-tooltip-after-move)
          ))))

(defun fr-translate-string-to-english (&optional string source-lang)
  "使用 translate-shell 程序来翻译 STRING 为英文(在 posframe 中显示).
SOURCE-LANG 是(被翻译的)源语言."
  (fr-translate-string string source-lang "en"))

(defun fr-translate-string-to-japanese (&optional string source-lang)
  "使用 translate-shell 程序来翻译 STRING 为日语(在 posframe 中显示).
SOURCE-LANG 是(被翻译的)源语言."
  (fr-translate-string string source-lang "ja"))

;; 注意, 由于 字符集 的问题, 目前只有 英文string 可以用
(defun fr-get-english-translation (&optional string source-lang)
  "使用 translate-shell 程序来翻译 STRING 为英语, 直接返回翻译的字符串.
SOURCE-LANG 是(被翻译的)源语言.
详细说明见 `fr-get-translation'."
  (fr-get-translation string source-lang "en"))

(defun fr-get-japanese-translation (&optional string source-lang)
  "使用 translate-shell 程序来翻译 STRING 为日语, 直接返回翻译的字符串.
SOURCE-LANG 是(被翻译的)源语言.
详细说明见 `fr-get-translation'."
  (interactive)
  (fr-get-translation string source-lang "ja"))

(defun fr-get-translation (&optional string source-lang target-lang)
  "使用 translate-shell 程序来翻译 STRING, 直接返回翻译的字符串.
SOURCE-LANG 是(被翻译的)源语言.
TARGET-LANG 是(翻译的)目标语言.
可以自动获取 选区/光标 处的字符串作为需要翻译的内容.
翻译的(简单)结果会被插入到 KILL-RING 中, 可以被黏贴使用."
  (interactive)
  ;; 需要 trim
  (condition-case err
      (let* ((params (fr-parse-translate-params string source-lang target-lang))
             (string (nth 0 params))
             (source-lang (nth 1 params))
             (target-lang (nth 2 params))
             (lang-opt (concat source-lang ":" target-lang))
             ;; 这样设置并不能起作用
             ;; (process-coding-system-alist '("[cC][mM][dD][pP][rR][oO][xX][yY]" . (utf-8 . gbk)))
             (result (s-trim-right (shell-command-to-string (format "%s -b %s %s" fr-trans-app-path lang-opt string))))
             )
        ;; 将翻译结果添加到 kill-ring 中, 便于 yank
        (kill-new result)
        result
        )
    (error (message "%s" (error-message-string err)))))

(defun fr-parse-translate-params (string source-lang target-lang)
  "处理翻译需要用到的参数.
STRING 是需要翻译的字符串.
SOURCE-LANG 是(被翻译的)源语言.
TARGET-LANG 是(翻译的)目标语言.
可以自动获取 选区/光标 处的字符串作为需要翻译的内容."
  (let* ((string (cond (string string)
                       ((use-region-p) ;; 如果有选区, 使用选区
                        (buffer-substring-no-properties (region-beginning) (region-end)))
                       ((thing-at-point 'word) ;; 如果光标处是一个单词, 直接翻译这个单词
                        (thing-at-point 'word))
                       (t (error "没有指定要翻译的字符串!")))
                 )
         (string (if (string-match "[ ]+" string)
                     (concat "'" string "'")
                   string)) ;; 如果字符串里面有空格, 用引号把字符串包围起来
         (source-lang (if source-lang
                          source-lang
                        "")) ;; 空字符串时, 会交给翻译引擎自行判断
         (target-lang (if target-lang
                          target-lang
                        "zh")) ;; 为了保证命令正常返回, 必须有 target-lang
         )
    (list string source-lang target-lang)))

(defun fr-translate-string (&optional string source-lang target-lang)
  "使用 translate-shell 程序来翻译 STRING, 将结果用 posframe 显示.
SOURCE-LANG 是(被翻译的)源语言.
TARGET-LANG 是(翻译的)目标语言.
可以自动获取 选区/光标 处的字符串作为需要翻译的内容."
  (interactive)
  (condition-case err
      (let* ((params (fr-parse-translate-params string source-lang target-lang)))
        (apply #'fr-translate-string-async params)
        )
    (error (message "%s" (error-message-string err))))
  )

(defun fr-translate-string-async (string source-lang target-lang)
  "使用 translate-shell 程序来翻译 STRING (异步方式).
SOURCE-LANG 是(被翻译的)源语言.
TARGET-LANG 是(翻译的)目标语言."
  (let* ((lang-opt (concat source-lang ":" target-lang)))
    (if (not (get-buffer fr-trans-temp-buffer))
        (progn
          (get-buffer-create fr-trans-temp-buffer)
          (with-current-buffer fr-trans-temp-buffer
            (add-hook 'after-change-functions
                      'fr-after-trans-buffer-changed
                      nil
                      t))))
    (setq fr-tooltip-last-point (point))
    (setq fr-tooltip-last-scroll-offset (window-start))
    ;; 执行之前先清空 buffer
    (with-current-buffer fr-trans-temp-buffer
      ;; delete-region 不会把删除的字符加入 kill-ring, 但是 kill-region 会
      (delete-region (point-min) (point-max)))
    ;; 这里直接用 make-process 来调用, 因为 start-process 不能控制编码, 输入汉字会造成乱码.
    (apply #'make-process
           (list :name "trans"
                 :buffer fr-trans-temp-buffer
                 :coding fr-trans-process-coding
                 :command (cons fr-trans-app-path (list lang-opt string))))
    ;; (start-process "trans" fr-trans-temp-buffer (expand-file-name "~/bin/trans") lang-opt string)
    ;; Show tooltip at point if word fetch from user cursor.
    (message "请稍等")))

;; (fr-translate-string "apple")
;; (fr-translate-string-to-japanese "苹果")

(provide 'fr-trans)
;;; fr-trans.el ends here
